#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

#  bgtop is a modified version of pbstop written by Garrick Staples 
#  <garrick@usc.edu> (see below). 
#  Please send comments to <a.federico@cineca.it>.

#  Copyright 2002, 2003, 2004, 2005 University of Southern California
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation or under the same terms as perl itself.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#  Latest version of this software may be found at:
#      http://www-rcf.usc.edu/~garrick/perl-PBS
#  Please send comments to garrick@usc.edu.

# configurable defaults
# Don't change the defaults here, instead make yourself a config file
my $num_nb          = 16;      # number of nodeboards per midplane
my $num_cn          = 32;      # number of compute nodes per nodeboard
my $max_io          = 32;      # max possible number of iolinks
my $columns         = $num_nb; # columns in grid
my $sleeptime       = 30;      # seconds between refreshes
my $colorize        = 1;       # 1 or 0
my $show_grid       = 1;       # 1 or 0
my $show_queue      = 1;       # 1 or 0
my $show_qqueue     = 1;       # 1 or 0
my $show_jobs       = 1;       # 1 or 0
my $show_user	    = "all";   # show only a given user's jobs
my $show_jobid	    = "";      # show only a given job
my $show_onlyq	    = "";      # show only this class
my $maxrows         = 1500;    # maximum number of rows
my $maxcolumns      = 250;     # maximum number of columns
my $fillbg          = 0;       # 1 or 0, fill the term background with black?
my $nospace         = 0;       # leave out spaces between the columns

my $llbgstatus      = "/usr/bin/llbgstatus";
my $llq             = "/usr/bin/llq";


#########################################################
### Nothing else to adjust below here

use strict;
use vars qw/$VERSION/;
use Curses;
use POSIX qw/strerror ceil/;
#use Getopt::Long 2.24 qw(:config no_ignore_case);
use autouse 'Pod::Usage' => qw(pod2usage);

$VERSION = "0.1";

# init a few global vars
my %Job_of_letter;
my @Colors = ();
my $masterletters = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
my $letters = $masterletters;
my $underline = 0;
my %searchobject=();
my $debug = 0;

my ( $y, $x, $Y, $X, $py, $px, $ly, $lx, $subY, $subX ) = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );

readrc("/etc/bgtoprc");
readrc("$ENV{HOME}/.bgtoprc");

-e $llbgstatus or chomp( $llbgstatus = `which llbgstatus 2>/dev/null` );
-e $llbgstatus or die "llbgstatus: Command not found\n";
-e $llq    or chomp( $llq = `which llq 2>/dev/null` );
-e $llq    or die "llq: Command not found\n";

# argument processing
my @argvhosts=();
while ( my $arg = shift @ARGV ) {
    if ( $arg eq '-s' ) {
        $sleeptime = shift @ARGV;
        $sleeptime =~ /^\d+$/ or $ARGV[0] = '-h';
        $sleeptime > 0 or $ARGV[0] = '-h';
    }
    elsif ( $arg eq '-d' ) {
        $debug = 1;
    }
    elsif ( $arg eq '-C' ) {
        $colorize = !$colorize;
    }
    elsif ( $arg eq '-G' ) {
        $show_grid = !$show_grid;
    }
    elsif ( $arg eq '-Q' ) {
        $show_queue = !$show_queue;
    }
    elsif ( $arg eq '-c' ) {
        $show_onlyq = shift @ARGV;
        $ARGV[0] = '-h' if $show_onlyq eq "";
    }
    elsif ( $arg eq '-t' ) {
        $show_qqueue = !$show_qqueue;
    }
    elsif ( $arg eq '-J' ) {
        $show_jobs = !$show_jobs;
    }
    elsif ( $arg eq '-fillbg' ) {
        $fillbg=1;
    }
    elsif ( $arg eq '-u' ) {
        if (defined $ARGV[0] and $ARGV[0] =~ /^([^-]+)/) {
            $show_user=join(' ', split(',', shift));
        } else {
            $ARGV[0] = '-h';
        }
    }
    elsif ( $arg eq '-j' ) {
        $show_jobid = shift @ARGV;
        $ARGV[0] = '-h' if $show_jobid eq "";
    }
    elsif ( $arg eq '-n' ) {
        $nospace = 1;
    }
    elsif ( $arg eq '-man' ) {
        pod2usage(-exitstatus => 0, -verbose => 2);
    }
    elsif ( $arg eq '-V' ) {
        print "bgtop $VERSION\n";
        exit(0);
    }
    else {
        print "Usage:  bgtop [-s seconds] [options] \n";
        print "   -s       seconds between refreshes\n";
        print "   -c       show only a class's jobs\n";
        print "   -u       show only a user's jobs\n";
        print "   -j       show only a given jobid\n";
        print "   -C       toggle colorization\n";
        print "   -G       toggle grid display\n";
        print "   -Q       toggle class display\n";
        print "   -t       toggle showing queued jobs in class display\n";
        print "   -n       no space between columns\n";
        print "   -J       toggle jobs in grid display\n";
        print "   -fillbg  fill background with black\n";
        print "   -man     show the man page\n";
        print "   -d       show debug warnings\n";
        print "   -V       print version and exit\n";
        exit(1);
    }
}

if ($show_user eq "all") {
   $show_user=0;
} elsif ($show_user =~ /\bme\b/) {
   $show_user=~ s/\bme\b/$ENV{USER}/;
}

use vars qw/$SIGWINCH/;
$SIGWINCH=0;
$SIG{'WINCH'} = sub {$SIGWINCH=1; };
$SIG{'INT'} = sub { endwin; exit(0); };
$SIG{'TERM'} = sub { endwin; exit(0); };
$SIG{'__DIE__'} = sub { endwin; die @_; };

if (! -t STDOUT) {
   $colorize=0;
}

# Is this portable?
my $CTRL_B=chr(ord("B")-ord("@"));
my $CTRL_F=chr(ord("F")-ord("@"));
my $CTRL_L=chr(ord("L")-ord("@"));
my $CTRL_G=chr(ord("G")-ord("@"));
my $CTRL_H=chr(ord("H")-ord("@"));

initscr;
cbreak;
noecho;
getmaxyx( $Y, $X );
$colorize=$colorize && has_colors();
my $pr = 0;
if ($colorize) {
   start_color;
   if ($fillbg) {
      $fillbg=COLOR_BLACK;
      assume_default_colors(COLOR_WHITE,COLOR_BLACK);
   } else {
      $fillbg=-1;
      assume_default_colors(-1,-1);
   }

   # This is every possible color combo list below.  Over time, I've commented out
   # color pairs that don't look very good.  If your eyes disagree with my eyes,
   # you are free to play around with this list.  But don't forget... only the
   # first $COLOR_PAIRS uncommented combos apply.  $COLOR_PAIRS is set by your
   # curses implementation.  pbstop's help screen (hit 'h' in pbstop) will tell
   # you the value of $COLOR_PAIRS.

   init_pair( ++$pr, COLOR_RED,      $fillbg );
   init_pair( ++$pr, COLOR_GREEN,    $fillbg );
   init_pair( ++$pr, COLOR_YELLOW,   $fillbg );
   init_pair( ++$pr, COLOR_BLUE,     $fillbg );
   init_pair( ++$pr, COLOR_MAGENTA,  $fillbg );
   init_pair( ++$pr, COLOR_CYAN,     $fillbg );
   #init_pair( ++$pr, COLOR_WHITE,    $fillbg );
   #init_pair( ++$pr, COLOR_BLACK,   COLOR_BLACK );
   #init_pair( ++$pr, COLOR_RED,     COLOR_WHITE );
   #init_pair( ++$pr, COLOR_GREEN,   COLOR_WHITE );
   #init_pair( ++$pr, COLOR_YELLOW,  COLOR_WHITE );
   #init_pair( ++$pr, COLOR_BLUE,    COLOR_WHITE );
   #init_pair( ++$pr, COLOR_MAGENTA, COLOR_WHITE );
   #init_pair( ++$pr, COLOR_CYAN,    COLOR_WHITE );
   #init_pair( ++$pr, COLOR_WHITE,   COLOR_WHITE );
   init_pair( ++$pr, COLOR_BLACK,   COLOR_WHITE );
   #init_pair( ++$pr, COLOR_RED,     COLOR_YELLOW );
   #init_pair( ++$pr, COLOR_GREEN,   COLOR_YELLOW );
   #init_pair( ++$pr, COLOR_YELLOW,  COLOR_YELLOW );
   #init_pair( ++$pr, COLOR_BLUE,    COLOR_YELLOW );
   init_pair( ++$pr, COLOR_MAGENTA, COLOR_YELLOW );
   #init_pair( ++$pr, COLOR_CYAN,    COLOR_YELLOW );
   #init_pair( ++$pr, COLOR_WHITE,   COLOR_YELLOW );
   #init_pair( ++$pr, COLOR_BLACK,   COLOR_YELLOW );
   init_pair( ++$pr, COLOR_RED,     COLOR_CYAN );
   #init_pair( ++$pr, COLOR_GREEN,   COLOR_CYAN );
   init_pair( ++$pr, COLOR_YELLOW,  COLOR_CYAN );
   #init_pair( ++$pr, COLOR_BLUE,    COLOR_CYAN );
   init_pair( ++$pr, COLOR_MAGENTA, COLOR_CYAN );
   #init_pair( ++$pr, COLOR_CYAN,    COLOR_CYAN );
   init_pair( ++$pr, COLOR_WHITE,   COLOR_CYAN );
   init_pair( ++$pr, COLOR_BLACK,   COLOR_CYAN );
   init_pair( ++$pr, COLOR_RED,     COLOR_MAGENTA ); 
   init_pair( ++$pr, COLOR_GREEN,   COLOR_MAGENTA );
   init_pair( ++$pr, COLOR_YELLOW,  COLOR_MAGENTA );  # current 16th
   init_pair( ++$pr, COLOR_BLUE,    COLOR_MAGENTA );
   #init_pair( ++$pr, COLOR_MAGENTA, COLOR_MAGENTA );
   init_pair( ++$pr, COLOR_CYAN,    COLOR_MAGENTA );
   init_pair( ++$pr, COLOR_WHITE,   COLOR_MAGENTA );
   #init_pair( ++$pr, COLOR_BLACK,   COLOR_MAGENTA );
   #init_pair( ++$pr, COLOR_RED,     COLOR_RED );
   init_pair( ++$pr, COLOR_GREEN,   COLOR_RED );
   init_pair( ++$pr, COLOR_YELLOW,  COLOR_RED );
   init_pair( ++$pr, COLOR_BLUE,    COLOR_RED );
   init_pair( ++$pr, COLOR_MAGENTA, COLOR_RED );
   init_pair( ++$pr, COLOR_CYAN,    COLOR_RED );
   init_pair( ++$pr, COLOR_WHITE,   COLOR_RED );
   init_pair( ++$pr, COLOR_BLACK,   COLOR_RED );
   init_pair( ++$pr, COLOR_RED,     COLOR_GREEN );
   #init_pair( ++$pr, COLOR_GREEN,   COLOR_GREEN );
   #init_pair( ++$pr, COLOR_YELLOW,  COLOR_GREEN );
   init_pair( ++$pr, COLOR_BLUE,    COLOR_GREEN );
   #init_pair( ++$pr, COLOR_MAGENTA, COLOR_GREEN );
   init_pair( ++$pr, COLOR_CYAN,    COLOR_GREEN );
   init_pair( ++$pr, COLOR_WHITE,   COLOR_GREEN );
   init_pair( ++$pr, COLOR_BLACK,   COLOR_GREEN );
}


sub init_colors {
    return ( 1 .. ($COLOR_PAIRS-1 > $pr ? $pr : $COLOR_PAIRS-1) );
}

my $pad = newpad( $maxrows, $maxcolumns );
my $cmdwin = newwin( 1, $X - 1, $Y - 1, 0 );
keypad( $cmdwin, 1 );
my $subwin=0;

addstr $cmdwin, 0, 0, "Starting...";
clrtoeol($cmdwin);
refresh($cmdwin);
move( $cmdwin, 0, 0 );
clrtoeol($cmdwin);

main_loop();

#   The original color set that I actually spent some time planning
#        "\033[07;34m",    "\033[07;35m",    "\033[07;36m",
#        "\033[07;37m",    "\033[01;37m",    "\033[35m",
#        "\033[36m",       "\033[37m",       "\033[34m",
#        "\033[33m",       "\033[32m",       "\033[01;36;45m",
#        "\033[01;30;47m", "\033[01;30;46m", "\033[36;45m",
#        "\033[30;47m",    "\033[30;46m",    "\033[01;33m",
#        "\033[01;34m",    "\033[01;35m",    "\033[01;36m",
#        "\033[01;31m",    "\033[01;32m",

###############################################################
## All subroutines below here
###############################################################

# main_loop() will 1) gather all of our data from pbs_server, 2) prep it a bit
# in letterize() and colorize(), 3) call update_display to draw our pretty
# grids and stuff, and finally calls 4) top_sleep which is where we spend most
# of our time.

# 1) We have two ways of gathering data: calling the perl-PBS module which
# connects directly to pbs_server and requests the desired data, or parsing the
# output of qmgr and qstat.  Clearly the former is desired.  The latter is only
# called if perl-PBS can't be found.  These subroutines are get_info_modPBS()
# and get_info_cmdline().  Since this data is kept between cycles around the
# main loop, we take some care to remove old data.  The result is two large 
# structures, one for Jobs and one for Nodes, which will carry us through 
# the rest of the entire program.

# 2) letterize() and colorize() are fairly unexciting, but they do assign
# letters and colors to each running job.  This info is stored in the large Job
# structure.  letterize() has probably the only original code left.

# 3) update_display(), by itself, is pretty boring.  It calls the functions
# responsible for the summary, colorful grid, and the job listing at the
# bottom.  show_grid() is pretty exciting; it first finds every node over
# $maxnodegrid, calls them "timesharing" and shoves them aside, draws a big
# colorful grid for what's left, and draws another colorful grid for the
# timesharing nodes.

# 4) top_sleep() is a big giant mess.  It is far too monolithic.  If anyone
# wants to chop it up a bit, feel free to send me patches!  Anyways, it loops
# around on user input until the time expires and it is time to return back up
# to main_loop().  In the meantime, it does everything the user requests,
# including grinding through the main data structures looking for stuff.  All of
# the code responsible for moving around the giant pad is here.


sub main_loop {
    my $maxlen;
    my %Midplanes;
    my %Jobs;
    my %State_count;

    # temp vars
    my $node;

    # Main event loop.
    while (1) {

        %State_count	      = ();
        $State_count{_mp}     = 0;
        $State_count{_ump}    = 0;
        $State_count{_nb}     = 0;
        $State_count{_unb}    = 0;
        $State_count{_cn}     = 0;
        $State_count{_ucn}    = 0;
        $State_count{_rjobs}  = 0;
        $State_count{_njobs}  = 0;

        get_info_cmdline(\%Midplanes, \%Jobs, \%State_count);

        # trim out old jobs that are no longer seen
        foreach my $job (keys %Jobs) {
            if (!exists $Jobs{$job}{seen} or !defined $Jobs{$job}{seen} or $Jobs{$job}{seen} != 1) {
               delete $Jobs{$job};
            } else {
               $Jobs{$job}{seen}=0;
            }
        }
    
        $maxlen = getmaxkeylen( \%Midplanes );
        letterize( \%Jobs );
        colorize( \%Jobs );

        update_display( \%State_count, \%Midplanes, \%Jobs, $maxlen);
        -t STDOUT or do { endwin; exit; };
        top_sleep( \%State_count, \%Midplanes, \%Jobs, $maxlen);

    }
}


sub get_info_cmdline {
    my ($Midplane, $Jobs, $State_count) = @_;
    my @llbgstatus = `$llbgstatus -M all 2>/dev/null`;    # find out everything
    $? and do { printwarning("$llbgstatus failed.") };
            
    my @llq = `$llq -f %id %o %c %jn %st %BGBN %BGCN 2>/dev/null`;
    $? and do { printwarning("$llq failed.") };
            
    my $job;
    foreach (@llq) {
        my @qs = split ( " ", $_ );
        if ( $qs[0] =~ /^[a-z]+/ ) {
            $job = $qs[0];
            $Jobs->{$job}{seen}=1;
            $Jobs->{$job}{user}    = $qs[1];
            $Jobs->{$job}{class}   = $qs[2];
            $Jobs->{$job}{jname}   = $qs[3];
            $Jobs->{$job}{state}   = $qs[4];
            $Jobs->{$job}{bgbn}    = $qs[5];
            $Jobs->{$job}{bgcn}    = $qs[6];
            if ($qs[4] eq "R") {
                $Jobs->{$job}{rank} = 0;
                $State_count->{"_rjobs"}++;
            }
            else {
                $Jobs->{$job}{rank} = 1;
            }
            $State_count->{"_njobs"}++;
        }
    }

    my $midplane="";
    my $nodeboard="";
    my $rank=0;
    my $nbrank=0;
    my ($state, $cb, $iolinks);
    foreach (@llbgstatus) {
        chomp;
        if (/^Midplane Location: /) {
            $midplane = $';
            delete $Midplane->{$midplane};
            $Midplane->{$midplane}{rank}=$rank++;
            $nbrank = 0;
        }
        elsif (/\s+Midplane State: (.*)/) {
            $state = $1;
            $Midplane->{$midplane}{state} = $state;
            $State_count->{$state}++;
        }
        elsif (/\s+Number of IOLinks: (.*)/) {
            $iolinks = $1;
            $Midplane->{$midplane}{iolinks} = $iolinks;
        }
        elsif (/\s+ComputeBlock: (.*)/) {
            $cb = $1;
            $cb = "NONE" if ( not search_jobid($Jobs, $cb) );
            for (my $i=0; $i<$num_nb; $i++) {
                $nodeboard = sprintf "$midplane-N%02d", $i;
                $Midplane->{$midplane}{$nodeboard}{cb} = $cb;
                $Midplane->{$midplane}{$nodeboard}{state} = "Available";
                $Midplane->{$midplane}{$nodeboard}{rank} = $nbrank++;
            }
        }
        elsif (/\s+NodeBoard Location=([-RMN0-9]+) State=([ \w]+) Quadrant=Q[1-4] ComputeBlock=(.*)/) {
            $nodeboard = $1;
            $state = $2;
            $cb = $3;
            $cb = "NONE" if ( not search_jobid($Jobs, $cb) );
            $Midplane->{$midplane}{$nodeboard}{cb} = $cb;
            $Midplane->{$midplane}{$nodeboard}{state} = $state;
            $Midplane->{$midplane}{$nodeboard}{rank} = $nbrank++;
        }
    }

    foreach $midplane (keys %$Midplane) {
        $State_count->{_mp}++;
        $State_count->{_nb} += $num_nb;
        $State_count->{_cn} += $num_nb * $num_cn;

        if ( ( $Midplane->{$midplane}{state} !~ /drained|Service|Error|Missing/i ) &&
           ( $Midplane->{$midplane}{iolinks} gt 0 ) ) {
            my $num_nb_per_iolinks = ceil($max_io / $Midplane->{$midplane}{iolinks});
            my @compute_block = (0) x ($num_nb / $num_nb_per_iolinks);
            my $mp_used = 0;

            my $bad_nb_state = 0;
            for (my $i=0; $i<$num_nb; $i++) {
                $nodeboard = sprintf "$midplane-N%02d", $i;
                $state = $Midplane->{$midplane}{$nodeboard}{state};
                if ($state !~ /Available/) {
                    my $j = int ($i / $num_nb_per_iolinks);
                    $compute_block[$j] = $compute_block[$j] | 1;
                    $bad_nb_state++;
                }
                $cb = $Midplane->{$midplane}{$nodeboard}{cb};
                if ( $cb !~ /NONE/) {
                    $State_count->{_unb}++;
                    $State_count->{_ucn} += $num_cn;
                    $mp_used = $mp_used | 1;
                }
            }
            $State_count->{_mp}-- if ($bad_nb_state eq $num_nb);
            $State_count->{_ump}++ if $mp_used;

            my $sum = 0;
            $sum += $_ for @compute_block;
            $State_count->{_nb} -= $sum * $num_nb_per_iolinks;
            $State_count->{_cn} -= $sum * $num_nb_per_iolinks * $num_cn;
        }
        else {
            $State_count->{_mp}--;
            $State_count->{_nb} -= $num_nb;
            $State_count->{_cn} -= $num_nb * $num_cn;
        }
    }
}


sub update_display {
    my $foo;
    move( $pad, 0, 0 );
    getmaxyx( $Y, $X );

    $y = 0, $x = 0;

    printwarning("Displaying summary...") if $debug;
    show_state_summary( $_[0] );

    printwarning("Displaying grid...") if $debug;
    $show_grid and show_grid( $_[2], $_[1], $_[3] );

    $show_grid
      and addstr( $pad, $y++, 15,
        "[.] Idle  [*] Error  [%] Drained  [@] Service  [!] Missing" );

    printwarning("Displaying queue...") if $debug;
    $show_queue and show_queue( $_[2] );

    printwarning("done.") if $debug;

    getyx( $pad, $ly, $foo );
    clrtobot($pad);

    pnoutrefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
    mvwin( $cmdwin, $Y - 1, 0 );
    update_subwin(@_);
    doupdate();
}

sub show_state_summary {
    my $t  = 1;
    my $t2 = 1;

    addstr $pad,
      sprintf(
        "Usage Totals: %d/%d %s, %d/%d %s, %d/%d %s, %d/%d %s",
        ${ $_[0] }{_ucn},
        ${ $_[0] }{_cn},
        "ComputeNodes",
        ${ $_[0] }{_unb},
        ${ $_[0] }{_nb},
        "NodeBoards",
        ${ $_[0] }{_ump},
        ${ $_[0] }{_mp},
        "Midplanes",
        ${ $_[0] }{_rjobs},
        ${ $_[0] }{_njobs},
        "Jobs Running"
      );

    my ( $y1, $x1 );
    getyx( $pad, $y1, $x1 );
    addstr $pad, " " x ( $X - $x1 - 8 );

    # Asbed asked for the time
    addstr $pad, sprintf( "%02d:%02d:%02d", ( localtime() )[ 2, 1, 0 ] );

    my ($line, $len);
    my @states = sort grep !/^_/, keys %{ $_[0] };

    my $statecolumns=int(($X-14)/25);
    for ( my $i = 0 ; defined $states[$i] ; ) {
        move( $pad, ++$y, $x = 0 );
        $line = " " x 16;

        for (my $k=1; $k<=$statecolumns; $k++) {
           last unless (defined $states[$i]);
           $len = length($states[$i]);
           $line.= sprintf( "%5s %-${len}s", ${ $_[0] }{ $states[$i] }, $states[$i] );
           $i++;
        }
        $line .= " " x ( $X - ( length($line) + 14 ) );
        clrtoeol($pad);
        addstr $pad, $line;
    }
    addstr( $pad, 1, 0, "Midplane States:" );
    move( $pad, ++$y, $x = 0 );
}

sub search_jobid {
    my ($jobs, $cb) = @_;
    foreach my $jobid (keys %$jobs) {
        if ( $jobs->{$jobid}{bgbn} ) {
            return $jobid if ( $jobs->{$jobid}{bgbn} eq "$cb" );
        }
    }
    return 0;
}

sub show_grid {
    my ( $jobs, $midplanes, $maxlen ) = @_;
    my ( $foo, $tmpx );
    $lx = 0;

    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );

    # loop through each node, in lines and columns
    my $col  = 0;
    
    my ($nodeboard, $letter, $color, $underline);
    my $headerspaces = $nospace ? 0 : 1;
    printheaderline ( $maxlen, $headerspaces, $columns );
    printdashline( $maxlen, $headerspaces, $columns );
    foreach my $midplane ( sort keys %$midplanes) {
        my $col = 0;
        my $mpstate = $midplanes->{$midplane}{state};
        my $iolinks = $midplanes->{$midplane}{iolinks};
        foreach my $nb (0 .. $num_nb-1) {
            $nodeboard = sprintf "$midplane-N%02d", $nb;
            $col = 0 if $col >= $columns;
            (addstr $pad, sprintf "  %${maxlen}s  ", $midplane) if $col == 0;
    
            my $state = $midplanes->{$midplane}{$nodeboard}{state};
            $state = "Missing" if ($mpstate =~ /Missing/);
            $state = "Service" if ($mpstate =~ /Service/);
            $state = "drained" if ($mpstate =~ /drained/ and $state =~ /Available/);
            my $cb    = $midplanes->{$midplane}{$nodeboard}{cb};
            my $jobid = search_jobid($jobs, $cb);
            if ($jobid) {
               if (exists $jobs->{$jobid} and exists $jobs->{$jobid}{letter} 
                   and ($show_jobid ? $show_jobid =~ /\b$jobid\b/ : 1)
                   and ($show_user ? $show_user =~ /\b$jobs->{$jobid}{user}\b/ : 1)
                   and ($show_onlyq ? $show_onlyq =~ /\b$jobs->{$jobid}{class}\b/ : 1)) {
                  $letter= $jobs->{$jobid}{letter};
                  $color = $jobs->{$jobid}{color};
                  $underline = $jobs->{$jobid}{underline};
                  printnbstate($jobid, $letter, $state, $color, $underline);
               } else {
                  printnbstate(0,0,$state,0,0);
               }
            } else {
               printnbstate(0,0,$state,0,0);
            }
    
            addstr $pad, "   " unless $nospace;
            $col++;
            getyx( $pad, $foo, $tmpx );
            $lx = $lx > $tmpx ? $lx : $tmpx;
    
            ($iolinks ? print_colored_number($iolinks, COLOR_BLACK, 0, 9) : 
                        print_colored_number($iolinks, COLOR_RED, 0, 9)) if $col == $columns;
            clrtoeol($pad);
            move( $pad, ++$y, $x = 0 ) if $col >= $columns;
        }
    }
    printdashline( $maxlen, $headerspaces, $columns );

    clrtoeol($pad);
}

sub print_colored_number {
    my ($number, $color, $underline, $move) = @_;
    my $len = length $number;
    $move = $move - $len;
    addstr $pad, " " x $move;
    $colorize or do { addstr $pad, $number; return };

    attron( $pad, A_BOLD | COLOR_PAIR( $color ) | ($underline && A_UNDERLINE) );
    addstr $pad, $number;
    attroff( $pad, A_BOLD | COLOR_PAIR( $color ) | ($underline && A_UNDERLINE) );
}

# Print out the job queue
sub show_queue {
    my $jobs = shift;

    move( $pad, ++$y, $x = 0 );

    attron( $pad, A_BOLD );
    addstr( $pad,"      Job ID               Owner    Class        Job Name        ST Block              Size  ");
    attroff( $pad, A_BOLD );
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );

    # Note: we never print out the server name, it is expected that the user will
    # recognize jobs by their jobid or queue name.

    my ($jobptr,$state);
    foreach my $job (
                     # Sort: first running jobs, then by size, then by queue last by jobid
                     sort {
                            (defined $jobs->{$a}{rank} 
                                && defined $jobs->{$b}{rank} 
                                && $jobs->{$a}{rank} <=> $jobs->{$b}{rank}) or
                            (defined $jobs->{$a}{bgcn} 
                                && defined $jobs->{$b}{bgcn} 
                                && $jobs->{$b}{bgcn} <=> $jobs->{$a}{bgcn}) or
                            (defined $jobs->{$a}{class} 
                                && defined $jobs->{$b}{class} 
                                && $jobs->{$a}{class} cmp $jobs->{$b}{class}) or
                            ($a cmp $b)
                           } keys %{$jobs} ) {

        $jobptr=$jobs->{$job};
        $state = $jobptr->{state};

        if ( defined $jobptr->{user} ) {

            next unless $show_jobid ? $show_jobid =~ /\b$job\b/ : 1;
            next unless $show_user ? $show_user =~ /\b$jobptr->{user}\b/ : 1;
            next unless $show_onlyq ? $show_onlyq =~ /\b$jobptr->{class}\b/ : 1;

                     # =~ /Q|H/ is slower
            if ( !( ($state eq "NQ" or $state eq "C" or $state eq "I" 
                    or $state eq "RM" or $state eq "CA") and !$show_qqueue ) ) {
                addstr $pad, "  ";
                if ( defined $jobptr->{letter} and $state eq "R" ) {
                    print_colored_letter($jobptr->{letter}, $jobptr->{color}, $jobptr->{underline});
                    addstr $pad, " = ";
                }
                else {
                    addstr $pad, "    ";
                }

                addstr $pad,
                  sprintf(
                    "%-20s %-8.8s %-12.12s %-15.15s %-2s %-16s %6s   ",
                    $job,
                    $jobptr->{user},
                    $jobptr->{class},
                    $jobptr->{jname},
                    $state,
                    exists $jobptr->{bgbn} ? $jobptr->{bgbn} : "",
                    exists $jobptr->{bgcn} ? $jobptr->{bgcn} : "");
                if ($state eq "E") {
                   attroff($pad, A_REVERSE);
                }
                clrtoeol($pad);
                move( $pad, ++$y, $x = 0 );
            }
        }
    }

    clrtoeol($pad);
}

# Pass in a reference to all jobs, and we'll assign a letter to each one.
sub letterize {
    my $Jobs    = shift;

    # The original pbstop only used one letter per job, and this info was held
    # in  %Job_of_letter.  Now that we've thrown out that limitation, it is only
    # used to note the fact that _someone_ is using that letter.  If a job gets
    # a letter that is already assigned, the second one will be noted in 
    # %Job_of_letter, but that's ok because we don't care _who_ has that letter.

    # remove info about old jobs and jobs already assigned a letter
    foreach my $l ( keys %Job_of_letter ) {
        delete $Job_of_letter{$l} if ( exists $Jobs->{ $Job_of_letter{$l} }{user} );
    }

    # pick a letter if not already choosen
    foreach my $job ( keys %{$Jobs} ) {
        next if !defined $Jobs->{$job}{state};
        next if $Jobs->{$job}{state} eq "Q";
        my $user = $Jobs->{$job}{user};
        if ( !exists $Jobs->{$job}{letter} ) {

            # find a letter that isn't already taken
            my $l = substr( $user, 0, 1 );
            if ( exists $Job_of_letter{$l} ) {
                $l = uc($l);
                if ( exists $Job_of_letter{$l} ) {
                    if (length $letters <= 0) {
                        # replenish our supply of letters
			$colorize or printwarning("Reusing letters on B&W terminal.");
		        $letters = $masterletters;
                        $underline=!$underline;
                    }
                    $letters =~ s/(.)//;
                    $l = $1;
                }
            }
            $Job_of_letter{$l}   = $job;
            $Jobs->{$job}{letter} = $l;
            $Jobs->{$job}{underline} = $underline;
            $letters =~ s/$l//;
        }
    }
}

# Pass in a reference to all jobs, and we'll assign a color to each one.
# We do this regardless of $colorize, so that the info is available if 
# the user changes color preference.
sub colorize {
    my $Jobs = shift or return;

    foreach my $job ( keys %{$Jobs} ) {
       next if defined $Jobs->{$job}{color};
       
       scalar @Colors == 0 and @Colors = init_colors();
       $Jobs->{$job}{color} = shift @Colors;
    }
}

    # This sucks, I wanted to seperate printing from colors,
    # but I can't just pass back color escape strings.
    # I'm forced to combine them here.
sub print_colored_letter {
    my ($letter, $color, $underline) = @_;
    $colorize or do { addstr $pad, $letter; return };

    attron( $pad, A_BOLD | COLOR_PAIR( $color ) | ($underline && A_UNDERLINE) );
    addstr $pad, $letter;
    attroff( $pad, A_BOLD | COLOR_PAIR( $color ) | ($underline && A_UNDERLINE) );
}

# Used to find the longest hostname to align the left side of the node grid
sub getmaxkeylen {
    my $maxlen_ = 0;
    foreach my $midplane ( keys %{ $_[0] } ) {
        foreach ( sort keys %{${ $_[0]}{$midplane}} ) {
            $maxlen_ =
              length($_) > $maxlen_
              ? length($_)
              : $maxlen_;
        }
    }
    return $maxlen_;
}

# This is each character inside the node grid.
sub printnbstate {
    my ($job, $letter, $state, $color, $underline) = @_;
    if ($job) {
        printwarning("$job has no letter") unless $letter;
        $letter='&' unless $letter;
    }

    if ( $state =~ /Error/ and $job ) {
       print_colored_letter( "*", $color, $underline );
    }
    elsif ( $job and $show_jobs ) {
       print_colored_letter( $letter, $color, $underline );
    }
    elsif ( $state =~ /Error/ ) {
       print_colored_letter( "*", 1, 0 );   # 1 is red on black
    }
    elsif ( $state =~ /drained/i ) {
       addch $pad, "%";
    }
    elsif ( $state =~ /Service/ ) {
       addch $pad, "@";
    }
    elsif ( $state =~ /Missing/ ) {
       addch $pad, "!";
    }
    else {
       print_colored_letter( ".", 1, 0 );
    }
}

# Print the line of dashes above and below the node grid.
sub printdashline {
    my $maxlen = shift;
    my $spaces = shift;
    my $columns = shift;

    my $line = "   " . " " x $maxlen;
    $line .= "----" x $spaces x $columns;
    $line =~ s/-$// unless $nospace;    # oops, we printed one extra, erase it
    $line .= "    " x $spaces . "-------";
    addstr $pad, $line;
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );
}

# Print the repetitive line of numbers along the top of the node grid.
sub printheaderline {
    my $maxlen = shift;
    my $spaces = shift;
    my $columns = shift;

    my $line= "   " . " " x $maxlen;
    for ( my $i = 0 ; $i < $columns ; $i++ ) {
        $line .= sprintf("N%02d", $i) . " " x $spaces;
    }
    $line .= "   " x $spaces . "IOLinks";
    addstr $pad, $y, 0, $line;
    clrtoeol($pad);
    move( $pad, ++$y, $x = 0 );

}

# This is used in top_sleep to annoy the user.
sub printwarning {
    attron( $cmdwin, A_REVERSE );
    addstr $cmdwin, 0, 0, join(" ", @_);
    attroff( $cmdwin, A_REVERSE );
    clrtoeol($cmdwin);
    refresh($cmdwin);
}

# This is used in top_sleep to solicit the user.
sub getstring {
    my $input="";
    my $ch;
    my $x=0;
    addstr $cmdwin, 0, 0, join(" ", @_);
    $x=length join(" ", @_);
    clrtoeol($cmdwin);
    refresh($cmdwin);
    echo;
    nodelay( $cmdwin, 0 );
    #getstr( $cmdwin,  $input );
    $ch=getch($cmdwin);
    while (1) {
        $ch=getch($cmdwin);
        if ($ch eq ERR) {  # ERR returned on timeout
            next;

        # why is this so freaking complicated??
        } elsif ($ch eq KEY_BACKSPACE or $ch eq KEY_DC or $ch eq $CTRL_H) {
            if (length $input) {
               $x--;
               move($cmdwin, 0, $x);
               delch($cmdwin);
               refresh($cmdwin);
               $input=~s/.$// ;
            } elsif ($ch eq KEY_BACKSPACE) {
               move($cmdwin, 0, $x);
            }
        } elsif ($ch eq $CTRL_G) {  # user abort
            $input="";
            last;
        } elsif ($ch eq "\n") {
            last;
        } else {
            $x++;
            $input.=$ch;
        }
    }
    $input =~ s/^\s+//;
    $input =~ s/\s+$//;
    noecho;
    move( $cmdwin, 0, 0 );
    clrtoeol($cmdwin);
    refresh($cmdwin);
    return $input;
}


# since we don't store enough info about jobs in %Jobs, go ahead and get
# it from the server
sub print_jobstatus_window {
    my $jobid=shift;
    my @attrs;
    my @llq=`$llq -l $jobid`;

    foreach (@llq) {
        chomp;
        my @qs = split ( ":", $_ , 2);
        $qs[0] =~ s/^\s+//;
        if ( $qs[0] =~ /^[ \w]+/ ) {
            $qs[1] =~ s/^\s+//;
            $qs[1] =~ s/\s+$//;
            push(@attrs, { name => $qs[0],  value => $qs[1] }) if $qs[1];
        }
    }
    print_status_window("$jobid", \@attrs);
}


# We already have everything we need to know about nodes in our big Midplanes
# struct, so just pull info from there.
sub print_midplanestatus_window {
   my $midplane=shift;
   my $ref=shift;
   
   my (@attrs, $nodeboard, $value);
   push(@attrs, { name => "Midplane State", value => $ref->{state} });
   push(@attrs, { name => "Number of IOLinks", value => $ref->{iolinks} });
   for (my $i=0; $i<$num_nb; $i++) {
        $nodeboard = sprintf "$midplane-N%02d", $i;
        $value = sprintf "%-11s | State = %-10s | ComputeBlock = %-20s", 
                    $nodeboard, $ref->{$nodeboard}{state}, $ref->{$nodeboard}{cb};
        push(@attrs, { name => "NodeBoard Location", value => $value } );
   }

   print_status_window("$midplane", \@attrs);
}

# This is used by the 4 subs above here to actually paint the subpad
sub print_status_window {
   my $title=shift;
   my $ref=shift;
   my $epilogue=shift;

   my $line=1;
   my $string;
   my $maxlinelen;
   my $pat;
   my $indent;

   my $name;
   my $value;

   # this subwin's width is 10 fewer than the main win, and with 2 chars padding inside,
   # each line will be 14 chars fewer than the width of the main window.
   $subwin = subpad( $pad, $maxrows-4, $maxcolumns-10, 2, 5 );
   $subwin or die;
   move($subwin, $line, 0);
   clrtoeol($subwin);
   move($subwin, $line, 2);

   foreach my $attr ( @{$ref}) {
      $name=$attr->{name};
      $value=$attr->{value};
      $indent=length($name)+2+3; # 2 for padding, 3 for " = "
      $maxlinelen=($X-14)-$indent;
      $pat=".{1,$maxlinelen}";

      addstr($subwin, $name." = ");
      $string=$value;

      if ( (length($string)+$indent) > $maxlinelen) {
         while (length($string)) {

            move ($subwin, $line, $indent);
            $string=~s/($pat)// or die "can't match '$string' with '$pat'";
            addstr $subwin, "$1";
            clrtoeol($subwin);
            move($subwin, ++$line, 0);
            clrtoeol($subwin);
            move($subwin, $line, 2);

            $indent=7;
            $maxlinelen=($X-14)-$indent;
            $pat=".{1,$maxlinelen}";
         }
         move($subwin, $line, 0);
         clrtoeol($subwin);
         move($subwin, $line, 2);
      } else {
         addstr $subwin, $string;
            clrtoeol($subwin);
         move($subwin, ++$line, 0);
         clrtoeol($subwin);
         move($subwin, $line, 2);
      }
   }

   move($subwin, ++$line, 0);
   clrtoeol($subwin);
   move($subwin, $line, 2);
   if (defined $epilogue) {
       $maxlinelen=$X-14;
       $epilogue="'q' to exit, $epilogue";

       # gah, wrapping on comma is freaking hard
       if (length($epilogue) >= $maxlinelen) {
          my $subpart=substr($epilogue, 0, $maxlinelen);
          my $subremain=substr($epilogue, $maxlinelen);
          while ($subpart=~/(.*, )(.*)/) {
             addstr $subwin, $1;
             move($subwin, ++$line, 0);
             clrtoeol($subwin);
             move($subwin, $line, 2);
             my $strlen=length("$2$subremain");
             if ($strlen >= $maxlinelen) {
                $subpart=substr("$2$subremain", 0, $maxlinelen);
                $subremain=substr("$2$subremain", $maxlinelen);
             } else {
                addstr $subwin, "$2$subremain";
                last;
             }
          }
       } else {
          addstr $subwin, $epilogue;
       }
   } else {
       addstr $subwin, "'q' to exit this window";
   }
   move($subwin, ++$line, 0);
   clrtoeol($subwin);

   # make a nice box window border for our output
   resize($subwin, $line+2, $X-10);
   attron( $subwin, COLOR_PAIR( 1 )) if $colorize;
   box($subwin, &ACS_VLINE, &ACS_HLINE);
   move($subwin, 0, 3);
   addch($subwin, &ACS_RTEE);
   addstr $subwin, "$title";
   addch($subwin, &ACS_LTEE);
   attroff( $subwin, COLOR_PAIR( 1 )) if $colorize;

   $subY=$line+4;
   $subX=$X-10;  # currently not used (since the subwin is always smaller than the terminal)
   if (($subY) < $py) {
      $py=0;
   }
   pnoutrefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
}

sub update_subwin {
   $subwin or return;
   if ($searchobject{TYPE} eq "MIDPLANE") {
        print_midplanestatus_window($searchobject{VALUE}, $_[1]->{$searchobject{VALUE}});
   } elsif ($searchobject{TYPE} eq "JOB") {
        print_jobstatus_window($searchobject{VALUE});
   } else {
        printwarning("oddly, I'm on line ".__LINE__);
   }
}

sub destroy_subwin {
   #delwin($subwin);
   $subwin=0;
   %searchobject=();
   $subY=0;
   $subX=0;
   if ($py >= $ly - $Y + 2) {
       $py = $ly - $Y + 3;
       pnoutrefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
   }
}

sub getconfirmation {
    my $action=shift;

    my $input=getstring("Confirm $action? (type \"yes\") ");

    return ($input eq "yes");
}

#FIXME#  top_sleep() is a kludge, I know it... It just keeps growing
#FIXME#  as I add new commands.  *shrug*
sub top_sleep {

    my $targettime = time() + $sleeptime;

    while ( time() < $targettime ) {
        halfdelay(1);
        my $input = getch($cmdwin);
        if ($SIGWINCH) {
           $SIGWINCH=0;
           endwin;
           refresh();
           update_display(@_);
        }
        if ( defined $input ) {
            if ( $input eq "q" ) {
                if ($subwin) {
                    destroy_subwin();
                    update_display(@_);
                } else {
                    endwin;
                    exit(0);
                }
            }
            # why doesn't curses do this automatically??
            elsif ( $input eq $CTRL_L ) {
                clear($pad);
                clrtoeol($cmdwin);
                update_display(@_);
            }

            #FIXME# $helpwin should be a scrollable pad
            elsif ( $input eq "h" || $input eq "?" ) {
                my $helpwin = newwin( 0, 0, 0, 0 );
                attron( $helpwin, A_REVERSE );
                attron( $helpwin, COLOR_PAIR(6) ) if $colorize;
                addstr $helpwin, "bgtop v$VERSION";
                attroff( $helpwin, A_REVERSE );
                attroff( $helpwin, COLOR_PAIR(6) ) if $colorize;
                move( $helpwin, 2, 0 );
                addstr $helpwin, "Seconds Refresh ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, "$sleeptime";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nColorization ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $colorize ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nGrid Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_grid ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nGrid Job Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_jobs ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nNo space (compact display) ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $nospace ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nQueue Display ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_queue ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nShow Queued Jobs ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $show_qqueue ? "on" : "off";
                attroff( $helpwin, A_BOLD );
                addstr $helpwin, "\nNumber of possible colors ";
                attron( $helpwin, A_BOLD );
                addstr $helpwin, $COLOR_PAIRS;
                attroff( $helpwin, A_BOLD );
                if ($show_user) {
                     addstr $helpwin, "\nLimiting job view by user to ";
                     attron( $helpwin, A_BOLD );
                     addstr $helpwin, $show_user;
                     attroff( $helpwin, A_BOLD );
                }
                if ($show_jobid) {
                     addstr $helpwin, "\nLimiting job view by jobid to ";
                     attron( $helpwin, A_BOLD );
                     addstr $helpwin, $show_jobid;
                     attroff( $helpwin, A_BOLD );
                }
                if ($show_onlyq) {
                     addstr $helpwin, "\nLimiting job view by class to ";
                     attron( $helpwin, A_BOLD );
                     addstr $helpwin, $show_onlyq;
                     attroff( $helpwin, A_BOLD );
                }
                addstr $helpwin, <<"__EOHELP__";


Interactive commands are:

 space   Update Display
 /       Search for a midplane or job and display details
 m       Midplane info
 q       Quit
 h       Print this help
 c       Limit view to specific class's jobs
 u       Limit view to specific users' jobs
 j       Limit view to specific job ID
 s       Seconds to refresh, accepts math operators (ie: 2*60)
 C       Toggle Colorization
 G       Toggle Grid Display
 Q       Toggle Queue Display
 t       Toggle Queued Jobs in Queue Display
 J       Toggle Show Jobs in Grid

Press any key to continue...
__EOHELP__

                refresh($helpwin);
                # wait for the user to hit the any key.
                cbreak;
                nodelay( $helpwin, 0 );
                getch($helpwin);
                halfdelay(1);
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
                move( $cmdwin, 0, 0 );
                clrtoeol($cmdwin);
                refresh($cmdwin);

                delwin($helpwin);
            }

            elsif ( $input eq "s" ) {
                $input=getstring("Number of seconds for refresh[$sleeptime]? ");

                if ($input) {
                    my $tmp;

                    # *grin* I love this use of eval
                    if ( $tmp = eval $input and $tmp > 0 ) {
                        $sleeptime  = $tmp;
                        $targettime = time() + $sleeptime;
                    }
                    else {
                        printwarning("Invalid number!");
                    }
                }

            }

            elsif ( $input eq "u" ) {
                $input=getstring("Limit view to \"all\" (a), \"me\", or username? ");

                if ($input) {
                    if ($input eq "all" or $input eq "a") {
                        $show_user=0;
                    } elsif ($input eq "me" or $input eq "m") {
                        $show_user=$ENV{USER};
                    } elsif ($input =~ /^\+(.*)/) {
                        if ($1 eq "me" or $1 eq "m") {
                           $show_user.= " ".$ENV{USER};
                        } else {
                           $show_user.= " $1";
                        }
                        $show_user =~ s/^ / /g;
                    } elsif ($input =~ /^-(.*)/) {
                        if ($1 eq "me" or $1 eq "m") {
                           $show_user =~ s/\b$ENV{USER}\b//;
                        } else {
                           $show_user =~ s/\b$1\b//;
                        }
                        $show_user =~ s/  / /g;
                        $show_user =~ s/^ / /g;
                        $show_user =~ s/ $/ /g;
                    } else {
                        $show_user=$input;
                    }
                    update_display(@_);
                }

            }

            elsif ( $input eq "j" ) {
                $input=getstring("Limit view to \"all\" (a), or job ID? ");

                if ($input) {
                    if ($input eq "all" or $input eq "a") {
                        $show_jobid=0;
                    } else {
                        $show_jobid=$input;
                    }
                    update_display(@_);
                }

            }

            elsif ( $input eq "c" ) {
                $input=getstring("Limit view to \"all\" (a), or class? ");

                if ($input) {
                    if ($input eq "all" or $input eq "a") {
                        $show_onlyq=0;
                    } else {
                        $show_onlyq=$input;
                    }
                    update_display(@_);
                }

            }

	    elsif ( $input eq "m" ) {
                $input=getstring("Midplane name? ");
                
                if ($input) {
                    foreach my $midplane (%{ $_[1] }) {
                        if ( exists $_[1]->{$input} ) {
                             $searchobject{TYPE}="MIDPLANE";
                             $searchobject{VALUE}=$input;
                             $subwin=1;
                             update_display(@_);
                             last;
                        }
                    }
                }
            }

            # Just about all of this should be moved out of here
            #FIXME# need to unify these searches somehow
	    elsif ( $input eq "/" ) {
                    $input=getstring("Search string? ");
                
                    if ($input) {
                        my @objects=();
                        my $searchtype="";
    
                        # did the user specify a pattern?
                        if ($input =~ s/^~(.)\s?//) {
                            if ($1 eq "j") {
                                $searchtype="job";
                            } elsif ($1 eq "m") {
                                $searchtype="midplane";
                            } else {
                                printwarning("Invalid search pattern");
                                next;
                            }
                        }
                        # what other information can we extract?
                        if ($input =~ /^[-RM0-9]+/) {
                            $searchtype||="midplane";
                        }
                        elsif ($input =~ /^[\d\w\.]+$/ ) {
                            $searchtype||="job";
                        }
                            
                        # we know everything we can, now go find stuff
                        if ($searchtype eq "job") {  
                           foreach my $job (%{ $_[2] }) {
                              if ( $input eq $job ) {
                                  push(@objects, $job);
                                  $searchobject{TYPE}="JOB";
                                  $searchobject{VALUE}="$job";
                              }
                           }
                        }

                        if ($searchtype eq "midplane" or !$searchtype) {
                            if (exists $_[1]->{$input} ) {
                               push(@objects, $input);
                               $searchobject{TYPE}="MIDPLANE";
                               $searchobject{VALUE}="$input";
                            }
                        }
                              
                        # if we have anything useful, go display it
                        if (scalar @objects > 1) {
                            printwarning("Multiple objects found.  Please narrow your search.");
                        } elsif (scalar @objects < 1) {
                            printwarning("no objects found matching $input ($searchtype)");
                        } elsif (exists $searchobject{TYPE} && defined $searchobject{TYPE}) {
                            $subwin=1;
                            update_display(@_);
                        }
                    }
            }

            # all of these toggles should be self-explanatory
            elsif ( $input eq "C" ) {
                $colorize = !$colorize;
		if ($colorize && !has_colors() ) {
		   printwarning("Terminal doesn't support colors");
		   $colorize=0;
		}
                update_display(@_);
            }
            elsif ( $input eq "G" ) {
                $show_grid = !$show_grid;
                update_display(@_);
            }
            elsif ( $input eq "Q" ) {
                $show_queue = !$show_queue;
                update_display(@_);
            }
            elsif ( $input eq "t" ) {
                $show_qqueue = !$show_qqueue;
                update_display(@_);
            }
            elsif ( $input eq "J" ) {
                $show_jobs = !$show_jobs;
                update_display(@_);
            }

            #FIXME# my home keyboard sends FIND and SELECT instead of HOME and END, weird?
            elsif ( $input eq KEY_HOME or $input eq KEY_SHOME or $input eq KEY_FIND ) {
                $py = 0;
                $px = 0;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq KEY_END or $input eq KEY_SEND  or $input eq KEY_SELECT) {
                $py = ($ly>$subY?$ly:$subY) + 2 - $Y;
                $px = 0;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq KEY_PPAGE or $input eq KEY_SPREVIOUS 
                    or $input eq $CTRL_B) {
                $py -= $Y -2;
                $py <= 0 and $py = 0;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq KEY_NPAGE or $input eq KEY_SNEXT 
                    or $input eq $CTRL_F) {
                $py += $Y - 2;
                $py >= ($ly>$subY?$ly:$subY) - $Y + 2 and $py = ($ly>$subY?$ly:$subY) + 2 - $Y;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "k" or $input eq KEY_UP ) {
                $py <= 0 and $py = 0, next;
                $py--;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "j" or $input eq KEY_DOWN) {
                $py >= ($ly>$subY?$ly:$subY) - $Y + 2 and next;
                $py++;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "h" or $input eq KEY_LEFT ) {
                $px <= 0 and $px = 0, next;
                $px -= 2;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }
            elsif ( $input eq "l" or $input eq KEY_RIGHT ) {
                $px >= $lx - $X + 1 and next;
                $px += 2;
                prefresh( $pad, $py, $px, 0, 0, $Y - 2, $X - 1 );
            }

            if ( $input eq " " ) {
                addstr $cmdwin, 0, 0, "Updating...";
                clrtoeol($cmdwin);
                refresh($cmdwin);
                move( $cmdwin, 0, 0 );
                clrtoeol($cmdwin);
                return;
            }
            # for debugging
            #else {
                #addstr $cmdwin, 0, 0, ord($input);
            #}

        }

    }
}

sub readrc {
   my ($f)=shift or return;
   return unless (-f $f);

   open(F, $f) or die "$f: $!\n";
   while ($_=<F>) {
      chomp;
      s/#.*//;
      next unless $_ =~ /=/;
      my ($name, $value) = split (/=/,$_,2);
      $name =~ s/\s//g;
      $value =~ s/\s//g;
      next if (length($name) <=0 or length($value) <=0);

      if ($name eq "show_user" ) {
         eval "\$$name=join(' ', split(',', \"$value\"))";
      } else {
         eval "\$$name=$value";
      }
   }
   close F;
}


__END__

=head1 NAME

bgtop - monitoring utility for LoadLeveler on IBM BG/Q systems

=head1 SYNOPSIS

bgtop [OPTION]...

=head1 DESCRIPTION

Draws a full-terminal display of nodeboards and jobs.  The grid shows the nodeboards 
(columns) for each midplane (rows) as a single character.  The specific character
denotes the state of the nodeboard or identifies the job running on that nodeboard.
The job listing shows the job name, class name, state, etc. and, on the far left,
the character used to identify nodeboards in the upper grid.

=head1 COMMAND-LINE OPTIONS

=over 4

=item   B<-s> num

seconds between refreshes

=item   B<-n>

don't put spaces between each nodeboard in the grid display for a more
compact display (no space)

=item   B<-c>

class name for limiting the view of the grid and job list.  Only one name is
supported at this time.

=item   B<-u>

usernames for limiting the view of the grid and job list.  Can be a
comma-seperated list of usernames or C<all>.  C<me> is a pseudonym for the
username running bgtop(1).

=item   B<-C>

toggle colorization

=item   B<-G>

toggle grid display

=item   B<-Q>

toggle queue display

=item   B<-t>

toggle showing queued jobs in queue display

=item   B<-J>

toggle jobs in grid display

=item   B<-fillbg>

fill the background with black instead of using the terminal's default

=item   B<-man>

display this man page

=item   B<-d>

show debug warnings

=item   B<-V>

print version and exit

=back

=head1 INTERACTIVE COMMANDS

Several single-key commands are recognized while bgtop(1) is running.  The
arrow keys, PageUp, and PageDown keys will scroll the display if it doesn't fit
in your terminal.

When prompted to type something, ctrl-g can be used to cancel the command.

=over 4

=item   B<space>

Immediately update display

=item B<q>

Quit bgtop(1)

=item B<h>

Display help screen, version, and current settings

=item B<s>

Prompts for the number of seconds to wait between display updates

=item B<c>

Prompts for a class name.  The grid and job listing will be limited to the named
class.  Input C<all> will remove all limitations (the default).

=item B<u>

Prompts for a username.  The grid and job listing will be limited to the named
user.  Can be a comma-seperated list of usernames. Input C<all> will remove all 
limitations (the default), and C<me> will limit to the current username running 
bgtop(1).  If the username or C<me> is prefixed with a C<+> or C<->, 
the username will be added or removed from the list of usernames to be limited.  
C<a> and C<m> are shortcuts for C<all> and C<me>.

=item B<j>

Prompts for a job ID.  The grid and job listing will be limited to the given
job.  Input C<all> will remove all limitations (the default).

=item B</>

Prompts the user for a search string, for displaying the details of.  The
search can optionally begin with one of the following pattern specifiers
(think: mutt): C<~m> for a midplane or C<~j> for a job number.
If no pattern specifier is found, bgtop will attempt to find the object that
best matches the search string. The string can be midplane or a
job number.  
If an object is found, a subwindow will be opened displaying details.  Hit C<q>
to exit the window.

=item B<m>

Prompts the user for a midplane, for displaying the details of.

=item B<C>

Toggle the use of the colors in the display

=item B<S>

Toggle the display of the state summary

=item B<G>

Toggle the display of the nodeboard grid

=item B<Q>

Toggle the display of the job queue

=item B<t>

Toggle the display of currently queued (not running) jobs in the display.  This
can reduce the size of the queue display considerably in some environments.

(Mnemonic: I don't know, toggle?  C<Q> was already used for something more important)

=item B<J>

Toggle the display of job letters in the nodeboard grid.  This handy because you can
see the nodeboard state "hidden" behind the job letter.  For example, use this to
see which nodeboards are not yet "busy" that have jobs.

=back

=head1 STARTUP

bgtop(1) has many configuration variables that can set on the command line,
interactively, or from configuration files.  When bgtop(1) starts, it first
initializes these variables with built-in defaults, then reads in
F</etc/bgtoprc>, the reads F<~/.bgtoprc>, and finally parses the command line
arguments.  Note that several of the command line arguments and interactive
commands are toggles, they don't directly set the value of the configuration.
In contrast, the configuration files are not toggles.

The configuration files may contain following name=value pairs:

=over 4

B<...COMING SOON...>

=back

=head1 FILES

=over 4

=item F</etc/bgtoprc>       The global configuration file

=item F<~/.bgtoprc>         The personal configuration file

=back

=head1 SEE ALSO

=over 4

=item I<llq>, I<llbgstatus>

=back

=head1 BUGS

=over 4

B<...>

=back

=head1 AUTHOR

bgtop(1) is a modified version of pbstop(1) written by Garrick Staples (see below).
Please send comments to E<lt>a.federico@cineca.itE<gt>.

pbstop(1) was originally written by Garrick Staples E<lt>garrick@usc.eduE<gt>.
The node grid and lettering concept is from Dennis Smith.  Thanks to Egan Ford
and the xCAT mailing list for testing and feedback.

